Interactivity

MACS 40700 University of Chicago

Visual information-seeking mantra

Overview first, zoom and filter, then details on demand

  1. Present the most important figures or most relevant points to the audience
  2. Allow readers to dig into the information, explore, and come up with their own stories

Linear vs non-linear

Think choose your own adventure stories.

Interaction techniques

  • Scroll and pan
  • Zoom
  • Open and close
  • Sort and rearrange
  • Search and filter

Central limit theorem

Central Limit Theorem Visualized in D3

Seeing theory

Seeing Theory: A visual introduction to probability and statistics

The changing American diet

The Changing American Diet

How (un)popular is Donald Trump?

How popular/unpopular is Donald Trump?

Gun deaths in America

Gun Deaths in America

You draw it

You Draw It: Just How Bad Is the Drug Overdose Epidemic?

Movie explorer

Movie explorer

Revenue effect of restoring the tax-preferred status

Revenue Effect of Restoring the Tax-Preferred Status of Over-the-Counter Drugs Purchased Through Health Savings Accounts, Flexible Spending Accounts, and Health Reimbusement Arrangements through the Repeal of Section 9003 of the Affordable Care Act.

America’s public bible

America’s Public Bible: Biblical Quotations in U.S. Newspapers

Interactive graphics in R

  • ggplot2 and ggvis
  • JavaScript libraries
    • D3
    • Highcharts
    • Leaflet
    • Plotly
  • Why use R?
  • htmlwidgets

plotly

  • Plot.ly
  • plotly.js
  • plotly API libraries

Generating plot_ly() objects

  • Trace(s)
  • plot_ly()
    • Somewhat equivalent to qplot()
  • add_() functions

Scatterplot

library(plotly)

plot_ly(data = mpg, x = ~displ, y = ~hwy,
        type = "scatter")
# alternative form
plot_ly(data = mpg, x = ~displ, y = ~hwy) %>%
  add_markers()

Add color

plot_ly(data = mpg, x = ~displ, y = ~hwy, color = ~class,
        type = "scatter")

Change the color palette

plot_ly(data = mpg, x = ~displ, y = ~hwy, color = ~class,
        type = "scatter",
        colors = "Accent")

Draw multiple plots together

subplot(
  plot_ly(mpg, x = ~cty, y = ~hwy, name = "default",
          type = "scatter"),
  plot_ly(mpg, x = ~cty, y = ~hwy) %>% 
    add_markers(alpha = 0.2, name = "alpha"),
  plot_ly(mpg, x = ~cty, y = ~hwy) %>% 
    add_markers(symbol = I(1), name = "hollow")
)

Add a smoothing line

plot_ly(mtcars, x = ~disp, color = I("black")) %>%
  add_markers(y = ~mpg, text = rownames(mtcars), showlegend = FALSE) %>%
  add_lines(y = ~fitted(loess(mpg ~ disp)),
            line = list(color = '#07A4B5'),
            name = "Loess Smoother", showlegend = TRUE)

Histogram

plot_ly(diamonds, x = ~price,
        type = "histogram")

Bar chart

p1 <- plot_ly(diamonds, x = ~cut) %>%
  add_histogram()

p2 <- diamonds %>%
  dplyr::count(cut) %>%
  plot_ly(x = ~cut, y = ~n) %>% 
  add_bars()

subplot(p1, p2) %>%
  hide_legend()

ggplotly()

p <- ggplot(mpg, aes(displ, hwy)) +
  geom_point()

ggplotly(p)

ggplotly()

p <- ggplot(mpg, aes(displ, hwy)) +
  geom_point(aes(color = class))

ggplotly(p)

ggplotly()

ggplotly(p +
           geom_smooth())

ggplotly()

p <- ggplot(mpg, aes(displ, hwy)) +
  geom_point(aes(color = class,
                 text = str_c(manufacturer, model, sep = " "))) +
  geom_smooth()

ggplotly(p)

Modifying ggplotly() objects

str(plotly_build(p), max.level = 2)
## List of 8
##  $ x            :List of 9
##   ..$ data     :List of 9
##   ..$ layout   :List of 10
##   ..$ config   :List of 3
##   ..$ source   : chr "A"
##   ..$ attrs    :List of 2
##   ..$ cur_data : chr "157e14d75cf07"
##   ..$ visdat   :List of 2
##   ..$ highlight:List of 6
##   ..$ base_url : chr "https://plot.ly"
##   ..- attr(*, "TOJSON_FUNC")=function (x, ...)  
##  $ width        : NULL
##  $ height       : NULL
##  $ sizingPolicy :List of 6
##   ..$ defaultWidth : chr "100%"
##   ..$ defaultHeight: num 400
##   ..$ padding      : NULL
##   ..$ viewer       :List of 6
##   ..$ browser      :List of 4
##   ..$ knitr        :List of 3
##  $ dependencies :List of 4
##   ..$ :List of 10
##   .. ..- attr(*, "class")= chr "html_dependency"
##   ..$ :List of 10
##   .. ..- attr(*, "class")= chr "html_dependency"
##   ..$ :List of 10
##   .. ..- attr(*, "class")= chr "html_dependency"
##   ..$ :List of 10
##   .. ..- attr(*, "class")= chr "html_dependency"
##  $ elementId    : chr "157e126d9da19"
##  $ preRenderHook:function (p, registerFrames = TRUE)  
##  $ jsHooks      :List of 1
##   ..$ render:List of 1
##  - attr(*, "class")= chr [1:2] "plotly" "htmlwidget"
##  - attr(*, "package")= chr "plotly"

Modifying ggplotly() objects

library(tidyverse)
library(stringr)
library(plotly)
library(rJava)
library(XLConnect)

options(digits = 3)
set.seed(1234)
theme_set(theme_minimal())


# function to convert outputs to tidy data frame
tidy_outputs <- function(outputs){
  outputs %>%
    as_tibble %>%
    gather(year, value, -Revenue.effect, convert = TRUE) %>%
    mutate(year = parse_number(year),
           Revenue.effect = factor(Revenue.effect,
                                   levels = c("User Model",
                                              "The Joint Committee on Taxation",
                                              "The Lindsey Group")))
}

# load model workbook and default inputs and outputs
# sorry i cannot share this file with you - it's proprietary
model <- loadWorkbook("data/OTCModelFeb2017rev5-Widget.xlsx")
model_inputs <- readWorksheet(model, "R-in")

# create color palette for graph
cbbpal <- c('#1b9e77', '#d95f02', '#7570b3')

# generate data
model_data <- tidy_outputs(readWorksheet(model, "R-out"))
model_data

# generate basic graph
g <- model_data %>%
  rename(Year = year, `Revenue effect` = value, `Model` = Revenue.effect) %>%
  ggplot(aes(Year, `Revenue effect`, color = Model)) +
  geom_line(size = 1.5) +
  scale_color_manual(values = cbbpal) +
  guides(color = guide_legend(nrow = 1)) +
  labs(x = "Year",
       y = "Millions (USD)",
       color = NULL) +
  theme_minimal(base_size = 14)

# static version
g

# plotly version
p <- plotly_build(g)
p

# view legend components
p$x$layout$legend

# fix legend position
p$x$layout$legend$x <- .5
p$x$layout$legend$y <- -.3
p$x$layout$legend$xanchor <- "center"
p$x$layout$legend$yanchor <- "top"
p$x$layout$legend$orientation <- "h"

p

# view structure
p$x$data[[1]]

# need to change the $text element - written in html
p$x$data[[1]]$text <- str_replace_all(p$x$data[[1]]$text,
                                      pattern = "`Revenue effect`", "Revenue effect")
p$x$data[[2]]$text <- str_replace_all(p$x$data[[2]]$text,
                                      pattern = "`Revenue effect`", "Revenue effect")
p$x$data[[3]]$text <- str_replace_all(p$x$data[[3]]$text,
                                      pattern = "`Revenue effect`", "Revenue effect")

p

What is Shiny?

  • R package from RStudio
  • Web application framework for R
  • R code \(\rightarrow\) interactive web page
  • No HTML/CSS/Javascript knowledge required
  • Great for sharing R analysis with someone scared of R

What is a Shiny app?

  • Computer running R
  • Web page
  • Computer performs calculations, sends contents to web page
  • User interacts with web page, sends updates back to computer
  • Rinse and repeat

Shiny app template

library(shiny)
ui <- fluidPage()
server <- function(input, output) {}
shinyApp(ui = ui, server = server)

Important: Do not place any code after shinyApp()

Run Shiny app in RStudio, method 1

Save file as app.R \(\rightarrow\) “Run” button turns to “Run App”

Good for creating Shiny apps quickly, all code in one file

Run Shiny app in RStudio, method 2

Save UI as ui.R and server as server.R in same directory

Good for complex Shiny apps, separates view vs logic

If using this method, do not include a call to shinyApp(...)

Run Shiny app in RStudio, method 3

File > New File > Shiny Web App…

Generates the template for you

Stop Shiny app in RStudio

Press “Esc” or click the Stop icon

Add elements to app inside fluidPage()

library(shiny)
ui <- fluidPage("Hello CFSS")
server <- function(input, output) {}
shinyApp(ui = ui, server = server)

Add elements to app inside fluidPage()

fluidPage(
    h1("My Shiny app"),
    "Hello CFSS"
)

Add HTML to fluidPage()

  • Remember the UI simply creates HTML
  • Can use any HTML tags
    • h1() = header1
    • br() = line break
    • strong() = bold text
  • Any HTML tag can be accessed using tags object
    • h1 = tags$h1(), br = tags$br()
  • Common tags can be accesed without tags

Add HTML to fluidPage()

fluidPage(
  h1("My Shiny app"),
  h3("Subtitle"),
  "Hello",
  "CFSS",
  br(),
  strong("bold text")
)

Use a layout

sidebarLayout()

fluidPage(
  titlePanel("My Shiny app"),
  sidebarLayout(
    sidebarPanel(
      "This is a side panel"
    ),
    mainPanel(
      "And this is the main stuff"
    )
  )
)

sidebarLayout()

Inputs and outputs

  • For interactivity, app needs inputs and outputs
  • Inputs - things user can toggle/adjust
  • Output - R objects user can see, often depend on inputs

Inputs and outputs

Inputs

library(shiny)

ui <- fluidPage(
  sliderInput(
    "num", "Choose a number",
    min = 0, max = 100,
    value = 20)
)

server <- function(input, output) {}

shinyApp(ui = ui, server = server)

Inputs

sliderInput("num", "Choose a number",
            min = 0, max = 100, value = 20)
print(sliderInput("num", "Choose a number",
            min = 0, max = 100, value = 20))
## <div class="form-group shiny-input-container">
##   <label class="control-label" for="num">Choose a number</label>
##   <input class="js-range-slider" id="num" data-min="0" data-max="100" data-from="20" data-step="1" data-grid="true" data-grid-num="10" data-grid-snap="false" data-prettify-separator="," data-prettify-enabled="true" data-keyboard="true" data-keyboard-step="1" data-data-type="number"/>
## </div>

Inputs

Inputs

sliderInput("num",
            "Choose a number",
            min = 0,
            max = 0,
            value = 20)

Outputs

  • Plots, tables, text - anything that R creates and users see
  • Initialize as empty placeholder space until object is created
Function Outputs
plotOutput() plot
tableOutput() table
uiOutput() Shiny UI element
textOutput() text

Outputs

sliderInput("num",
            "Choose a number",
            min = 0,
            max = 0,
            value = 20)

Outputs

library(shiny)

ui <- fluidPage(
  sliderInput("num", "Choose a number",
              0, 100, 20),
  plotOutput("myplot")
)

server <- function(input, output) {}

shinyApp(ui = ui, server = server)

Summary

  • Begin app with template
  • Add elements as arguments to fluidPage()
  • Create inputs with *Input() functions
  • Create outputs with *Output() functions
  • Use server to assemble inputs into outputs

Why doesn’t my app run?

Remember to:

  • Comma-separate all the elements
  • Not add comma to the last element

Server: assemble input into outputs with 3 rules

server <- function(input, output) {
    output$myplot <- renderPlot({
        plot(rnorm(input$num))
    })
}
  1. Save objects into output$
  2. Build objects with render*()

Output() \(\rightarrow\) render*()

Output function Render function
plotOutput() renderPlot({})
tableOutput() renderTable({})
uiOutput() renderUI({})
textOutput() renderText({})

render*() functions build reactive output to display in UI

renderPlot({
  plot(rnorm(100))
})

Server: assemble input into outputs with 3 rules

server <- function(input, output) {
    output$myplot <- renderPlot({
        plot(rnorm(input$num))
      
      # in UI:sliderInput("num", ...)
    })
}
  1. Save objects into output$
  2. Build objects with render*()
  3. Access input values with input$

Reactivity

  • Shiny uses reactive programming
  • Reactive variables
    • When value of variable x changes, anything that relies on x is re-evaluated
    • Contrast with regular R:

      x <- 5
      y <- x + 1
      x <- 10
      # y is still 6

Reactivity

  • input$num is a reactive value

    output$myplot <- renderPlot({
      plot(rnorm(input$num))
    })
  • output$myplot depends on input$num
    • input$num changes \(\rightarrow\) output$myplot reacts
  • All inputs are automatically reactive, so if you use any input inside a render* function, the output will re-render any time input changes

Reactive contexts

  • You can define your own reactive variables
  • Reactive values can only be used inside reactive contexts
  • Any render* function is a reactive context
  • Use reactive({...}) to assign a reactive variable
  • Use observe({...}) to access a reactive variable
  • Remember: reactive variable means anything that depends on it gets re-executed automatically

Reactive contexts

Assign variable
server <- function(input, output) {
    x <- input$num + 1
}
# error
server <- function(input, output) {
  x <- reactive({
    input$num + 1
  })
}
# OK

Simple Shiny app using basic reactivity

library(shiny)
ui <- fluidPage(
  sliderInput("num", "Choose a number",
              0, 100, 20),
  plotOutput("myplot")
)

server <- function(input, output) {
  output$myplot <- renderPlot({
    plot(seq(input$num))
  })
  x <- reactive({
    input$num + 1
  })
  observe({
    print(x())
  })
}

shinyApp(ui = ui, server = server)

Using buttons in the UI

  • Different from other inputs: you usually don’t care about the “value” of the button, you care when it’s clicked

    ui <- fluidPage(
      actionButton("btn", "Click me")
    )
    server <- function(input, output, session) {
      observe({
        cat(input$btn)
      })
    }
    shinyApp(ui = ui, server = server) 

Share your app: shinyapps.io

  • Go to http://www.shinyapps.io/ and make an account
  • Make sure all your app files are in an isolated folder
  • Click “Publish Application” in RStudio
    • You might be asked to install a couple packages
    • Follow instructions from RStudio

Shiny in Rmarkdown

---
output: html_document
runtime: shiny
---

```{r echo=FALSE, eval = TRUE}
sliderInput("num", "Choose a number",
            0, 100, 20)

renderPlot({
    plot(seq(input$num))
})
```

Use conditionalPanel() to conditionally show UI elements

library(shiny)
ui <- fluidPage(
  numericInput("num", "Number", 5, 1, 10),
  conditionalPanel(
    "input.num >=5",
    "Hello!"
  )
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)

Use navbarPage() or tabsetPanel() to have multiple tabs in the UI

library(shiny)
ui <- fluidPage(
  tabsetPanel(
    tabPanel("Tab 1", "Hello"),
    tabPanel("Tab 2", "there!")
  )
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)

Use DT for beautiful, interactive tables

  • tableOutput() + renderTable()
  • DT::dataTableOutput() + DT::renderDataTable()

Use update*Input() functions to update input values programmatically

library(shiny)
ui <- fluidPage(
  sliderInput("slider", "Move me", value = 5, 1, 10),
  numericInput("num", "Number", value = 5, 1, 10)
)
server <- function(input, output, session) {
  observe({
    updateNumericInput(session, "num", value = input$slider)
  })
}
shinyApp(ui = ui, server = server)

Scoping rules in Shiny apps

  • Global objects
  • server()
    • Sandbox for individual users

Add JavaScript/CSS

library(shiny)
ui <- fluidPage(
  tags$head(tags$script("alert('Hello!');")),
  tags$head(tags$style("body{ color: blue; }")),
  "Hello"
)
server <- function(input, output) {
  
}
shinyApp(ui = ui, server = server)

Next week

  • highcharter
  • flexdashboard and information dashboards